{-# LANGUAGE ScopedTypeVariables #-}

-- Notification on comment updates in livejournal

import Data.Char
import Data.ConfigFile
import Data.Either.Utils
import Data.List
import Data.Maybe
import Network.HTTP
import System.Directory
import System.IO
import System.Process

app_name = "lj-comments-notifier"

-- current implementation works only for
-- Modernist Birch lj-template

-- aux routines ----------------------------------------------------------
findSubstr str substr = findIndices (substr `isPrefixOf`) (tails str)

findFirstSubstr str substr = fromJust $ 
    findIndex (substr `isPrefixOf`) (tails str)

splitAtAll [] s = [s]
splitAtAll (id:ids) s = let (s1, s2) = splitAt id s in 
    s1 : splitAtAll (map (\a -> a - id)  ids) s2

listToPair (x1:x2:xs) = (x1, x2)
-- END OF aux routines ------------------------------------------------------

-- proccessing html body of lj page -----------------------------------------
commentLabel = " comment"

-- template dependent
-- returns string with which html code of every post begins
postDiv uname = "\"asset-" ++ uname ++ "-"

-- template dependent
-- extract number of comments from html chunk holding a post
commentsCount p = 
    let (s, _) = splitAt (findFirstSubstr p commentLabel) p in
    (read (takeWhile isDigit $ reverse s))::Int
-- END OF proccessing html body of lj page ----------------------------------

-- business logic -----------------------------------------------------------
-- analysis of new comments/posts appeared

getPostIdsWithCommentsCount (post, id, 2) = (id, commentsCount post)
getPostIdsWithCommentsCount (post, id, spec) = (id, spec - 1)

extractCommentsCnt uname body =
    let 
        userPostDiv = postDiv uname
        idPostsPos = map (length userPostDiv +) $ findSubstr body userPostDiv
        posts = tail $ splitAtAll idPostsPos body
        idPosts = map 
            ((read . takeWhile isDigit)::String -> Int)
            posts
        postWithIdsAndCommentsSpecs = zip3 posts idPosts $
            map (\p -> length $ findSubstr p commentLabel) posts
        in map
            getPostIdsWithCommentsCount
            postWithIdsAndCommentsSpecs

-- we assume that posts can't be rearranged
-- (i.e. a post can't be editted to change its date)
postsWithNewComments oldData [] = error "No new data supplied."
postsWithNewComments oldData newData@((np, nc):ns) = do
    let oldPosts = map fst oldData
    let (oldPostsNewData, newPostsData) = 
            partition (\(newpost, _) -> elem newpost oldPosts) newData
    return $
            (map fst $ filter (\(p, c) -> c > 0) newPostsData)
            ++ (map (fst . fst) $ 
                filter (\((op, oc), (op', nc)) -> oc < nc) 
                    $ zip oldData oldPostsNewData)

-- END OF business logic -----------------------------------------------------

-- housekeeping: networking, files, etc.… ------------------------------------

-- lj-escaping used in urls
ljEscape = map (\c -> if c == '_' then '-' else c)

userPostCommentMap uname = do
    rsp <- Network.HTTP.simpleHTTP
            (getRequest $ "http://" ++ (ljEscape uname) ++ ".livejournal.com/"
            ++ "/?s2id=20629198")
    body <- getResponseBody rsp
    return $ extractCommentsCnt uname body

saveDataToFile fileName theData = 
    writeFile fileName $ unlines $ 
        map (\(a, b) -> show a ++ " " ++ show b) theData

configDirectory = do
    dir <- getAppUserDataDirectory app_name
    return (dir ++ "/")

unameTofilename uname = uname ++ ".txt"

loadDataFromFile fileName = do
    contents <- readFile fileName
    return $ map (listToPair . map (read::String->Int) . words) $ lines contents

newsToLinks uname news = map 
        (\postId -> "http://" ++ ljEscape uname ++ 
            ".livejournal.com/" ++ (show postId) ++ ".html")
        news

notifyUser notifyAddress uname [] = return ()

notifyUser notifyAddress uname news = do
    configDir <- configDirectory
    runCommand $ " echo \"" 
            ++ "New comments in posts:\n"
            ++ (unlines $ newsToLinks uname news)
            ++ "\" | mailx -s \""
            ++ uname ++ "@lj comments watchdog\" "
            ++ notifyAddress
    return ()
-- END OF housekeeping: networking, files, etc.… -----------------------------

loadConfig = do 
    cfgDir <- configDirectory
    cp' <- readfile emptyCP 
        (cfgDir ++ "config.cfg")
    let cp = forceEither cp'
    let uname::String = forceEither $ get cp "DEFAULT" "uname"
    let notifyAddress::String = forceEither $ 
            get cp "DEFAULT" "notifyaddress"
    return (uname, notifyAddress)

main = do 
    (uname, notifyAddress) <- loadConfig

    newData <- userPostCommentMap uname
    cfgDir <- configDirectory
    let fname = cfgDir ++ unameTofilename uname
    oldDataExists <- doesFileExist fname
    oldData <- if oldDataExists then loadDataFromFile fname else return []
    newData <- userPostCommentMap uname
    news <- postsWithNewComments oldData newData
    notifyUser notifyAddress uname news
    removeFile fname
    saveDataToFile fname newData
    print $ newsToLinks uname news

